home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / utils / file / managers / mc-3.2 / mc-3 / mc-3.2.1 / tk / mc.tcl < prev    next >
Encoding:
Text File  |  1996-05-17  |  31.4 KB  |  1,192 lines
  1. # Midnight Commander Tk initialization.
  2. # Copyright (C) 1995 Miguel de Icaza
  3. #
  4. #   
  5. #   This program is free software; you can redistribute it and/or modify
  6. #   it under the terms of the GNU General Public License as published by
  7. #   the Free Software Foundation; either version 2 of the License, or
  8. #   (at your option) any later version.
  9. #   
  10. #   This program is distributed in the hope that it will be useful,
  11. #   but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13. #   GNU General Public License for more details.
  14. #
  15. #   You should have received a copy of the GNU General Public License
  16. #   along with this program; if not, write to the Free Software
  17. #   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  */
  18.  
  19. #
  20. # Menu routines
  21. #
  22. proc create_top_menu {} {
  23.     global top_menus
  24.     set top_menus ""
  25.  
  26.     frame .mbar -relief raised -bd 2
  27.  
  28.     pack .mbar -side top -fill x
  29.     menubutton .mbar.tk -text "Tk options" -underline 0 -menu .mbar.tk.menu
  30.     pack .mbar.tk -side right
  31.     menu .mbar.tk.menu 
  32.  
  33.     .mbar.tk.menu add command -label "Broken: Color model" -command color_model
  34.     .mbar.tk.menu add command -label "Broken: Font..." -command font_choose
  35. }
  36.  
  37. #
  38. # This routine is completely broken
  39. #
  40. #
  41. proc setfont {scheme} {
  42.     set panelfont $scheme
  43.     if [string compare $scheme miguel] {
  44.     set panelfont lucidasanstypewriter-bold-14
  45.     }
  46.     .left.m.panel configure -font $panelfont
  47.     .right.m.panel configure -font $panelfont
  48.     .p.i0 configure -font $scheme
  49.     .p.l5 configure -font $scheme
  50. }
  51.  
  52. #
  53. # This is, BTW, too.
  54. #
  55. #
  56. proc font_choose {} {
  57.     toplevel .font
  58.     button .font.1 -text "Fixed" -command {setfont fixed; destroy .font}
  59.     button .font.2 -text "Courier" -command {setfont courier; destroy .font}
  60.     button .font.3 -text "Miguel's" -command {setfont miguel; destroy .font}
  61.  
  62.     pack .font.1 .font.2 .font.3 -side left -padx 4m -pady 4m
  63. }
  64.  
  65. #
  66. # Widget: Menu
  67. #
  68. proc create_menu {str topmenu} {
  69.     global top_menus
  70.  
  71.     menubutton .mbar.$topmenu -text $str -underline 0 -menu .mbar.$topmenu.menu
  72.     pack .mbar.$topmenu -side left
  73.     menu .mbar.$topmenu.menu
  74.     set top_menus "$top_menus $topmenu"
  75. }
  76.  
  77. proc create_mentry {topmenu entry cmd idx} {
  78.     .mbar.$topmenu.menu add command -label "$entry" -command "$cmd $idx"
  79. }
  80.  
  81. proc add_separator {topmenu} {
  82.     .mbar.$topmenu.menu add separator
  83. }
  84.  
  85. proc newbutton {name cmd text} {
  86.     button $name -text "$text" -command $cmd -justify left
  87. }
  88.  
  89. #
  90. # Widget: WGauge
  91. #
  92. proc newgauge {win} {
  93.     global setup
  94.  
  95.     canvas $win -height $setup(heightc) -width 250 -relief sunken -border 2
  96.     $win create rectangle 0 0 0 0 -tags gauge -fill black -stipple gray50
  97.  
  98.     # So that we can tell the C code, which is the gauge size currently
  99.     bind $win <Configure> "x$win %w"
  100. }
  101.  
  102. # Used to show the gauge information
  103. proc gauge_shown {win} {
  104.     # $win configure -relief sunken -border 2
  105. }
  106.  
  107. # Used to hide the gauge information.
  108. proc gauge_hidden {win} {
  109.     # $win configure -relief flat -border 0
  110.     $win coords gauge 0 0 0 0
  111. }
  112.  
  113. #
  114. # Widget: WView
  115. #
  116. proc view_size {cmd w h} {
  117.     global setup
  118.  
  119.     $cmd dim [expr $w/$setup(widthc)] [expr $h/$setup(heightc)]
  120. }
  121.  
  122. proc newview {is_panel container winname cmd} {
  123.     global setup 
  124.  
  125.     # FIXME: The trick to get the window without too much
  126.     # movement/flicker is to use an extra frame, and use the placer
  127.     # like it was done in WInfo.
  128.     if $is_panel {
  129.     set width  [expr [winfo width $container]/$setup(widthc)]
  130.     set height [expr [winfo height $container]/$setup(heightc)]
  131.     }
  132.  
  133.     frame $winname
  134.     frame $winname.v
  135.     frame $winname.v.status
  136.     eval text $winname.v.view -font $setup(panelfont) $setup(view_normal)
  137.     
  138.     # Create the tag names for the viewer attributes
  139.     eval $winname.v.view tag configure bold $setup(view_bold)
  140.     eval $winname.v.view tag configure underline $setup(view_underline)
  141.     eval $winname.v.view tag configure mark $setup(view_mark)
  142.     eval $winname.v.view tag configure normal $setup(view_normal)
  143.     
  144.     # Make the status fields
  145.     label $winname.v.status.filename
  146.     label $winname.v.status.column
  147.     label $winname.v.status.size
  148.     label $winname.v.status.flags
  149.     
  150.     pack $winname.v.status.filename -side left
  151.     pack $winname.v.status.column   -anchor w -side left -fill x -expand 1
  152.     pack $winname.v.status.size     -anchor w -side left -fill x -expand 1
  153.     pack $winname.v.status.flags    -anchor w -side left -fill x -expand 1
  154.     
  155.     # Pack the main components
  156.     pack $winname.v.status -side top -fill x
  157.     pack $winname.v.view -side bottom -expand 1 -fill both
  158.     pack $winname.v -expand 1 -fill both
  159.     
  160.     bindtags $winname.v.view "all . $winname.v.view"
  161.     bind $winname.v.view <Configure> "view_size $cmd %w %h"
  162.  
  163.     if $is_panel {
  164.     $winname.v.view configure -width $width -height $height
  165.     pack $winname
  166.     }
  167. }
  168.  
  169. proc view_update_info {win fname col size flags} {
  170.     $win.v.status.filename configure -text "File: $fname"
  171.     $win.v.status.column   configure -text "Column: $col"
  172.     $win.v.status.size     configure -text "$size bytes"
  173.     $win.v.status.flags    configure -text "$flags"
  174. }
  175.  
  176. #
  177. # Hack: remove all the text on the window and then insert
  178. # new lines.  Maybe the newlines
  179. proc cleanview {win} {
  180.     $win delete 1.0 end
  181.     $win insert 1.0 "\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n"
  182. }
  183.  
  184. #
  185. # Widget: WRadio
  186. #
  187. proc newradio {name} {
  188.     frame $name
  189.     global last_radio 
  190.     set last_radio $name
  191. }
  192.  
  193. proc radio_item {idx text cmd act} {
  194.      global last_radio
  195.      radiobutton $last_radio.$idx -text "$text" -variable v$last_radio -value $idx -command "$cmd select $idx"
  196.      if $act {
  197.      $last_radio.$idx select 
  198.      }
  199.      pack $last_radio.$idx -side top -anchor w
  200. }
  201.  
  202. #
  203. # Widget: Input
  204. #
  205. #
  206.  
  207. proc entry_save_sel {win} {
  208.     global sel
  209.  
  210.     if [$win selection present] {
  211.     set sel(pres) 1
  212.     set sel(first) [$win index sel.first]
  213.     set sel(last)  [$win index sel.last]
  214.     } else {
  215.     set sel(pres) 0
  216.     }
  217. }
  218.  
  219. proc entry_restore_sel {win} {
  220.     global sel
  221.  
  222.     if $sel(pres) {
  223.     $win selection from $sel(first) 
  224.     $win selection to $sel(last)
  225.     }
  226. }
  227.  
  228. proc entry_click {win x} {
  229.     global sel
  230.     set p [$win index @$x] 
  231.     x$win mouse $p
  232.     x$win setmark
  233.     set sel(from) $p
  234. }
  235.  
  236. proc entry_move {win x} {
  237.     global sel
  238.     set p [$win index @$x]
  239.     $win selection from $sel(from) 
  240.     $win selection to $p
  241.     x$win mouse $p
  242. }
  243.  
  244. proc bind_entry {win} {
  245.     bind $win <1>         "entry_click $win %x"
  246.     bind $win <B1-Motion> "entry_move $win %x"
  247. }
  248.  
  249. proc newinput {name text} {
  250.     entry $name -relief sunken
  251.     $name insert 0 "$text"
  252.     bindtags $name "all . $name "
  253.     bind_entry $name
  254. }
  255.  
  256. #
  257. # Widget: WCheck
  258. #
  259. proc newcheck {name cmd text act} {
  260.     checkbutton $name -text "$text" -command "$cmd" 
  261.     if $act { $name select }
  262. }
  263.  
  264. #
  265. # Widget: WInfo
  266. #
  267. # window is the container name and widget name: .left.o2
  268. # container is the container name: .left
  269. #
  270. proc newinfo {container window version} {
  271.     global setup
  272.  
  273.     set width  [winfo width $container]
  274.     set height [winfo height $container]
  275.  
  276.     frame $window -width $width -height $height \
  277.     -borderwidth [expr $setup(widthc)/2]
  278.  
  279.     frame $window.b
  280.     frame $window.b.v
  281.     frame $window.b.finfo -relief groove -borderwidth 2
  282.     frame $window.b.fs -relief groove -borderwidth 2
  283.  
  284.     label $window.b.v.version -text "  The Midnight Commander $version  " \
  285.     -relief groove
  286.     pack  $window.b.v.version -fill x
  287.  
  288.     label $window.b.finfo.fname
  289.     label $window.b.finfo.location -text "test2"
  290.     label $window.b.finfo.mode
  291.     label $window.b.finfo.links
  292.     label $window.b.finfo.owner
  293.     label $window.b.finfo.size
  294.     label $window.b.finfo.created
  295.     label $window.b.finfo.modified
  296.     label $window.b.finfo.access
  297.     pack  $window.b.finfo.fname \
  298.     $window.b.finfo.location $window.b.finfo.mode $window.b.finfo.links \
  299.     $window.b.finfo.owner $window.b.finfo.size $window.b.finfo.created \
  300.     $window.b.finfo.modified $window.b.finfo.access \
  301.     -side top -anchor w 
  302.  
  303.     label $window.b.fs.fsys
  304.     label $window.b.fs.dev
  305.     label $window.b.fs.type
  306.  
  307.     frame  $window.b.fs.free
  308.     label  $window.b.fs.free.label
  309.     newcanvas $window.b.fs.free.canvas
  310.  
  311.     pack $window.b.fs.free.label -side left
  312.     pack $window.b.fs.free.canvas -side left
  313.  
  314.     frame  $window.b.fs.freeino
  315.     label  $window.b.fs.freeino.label
  316.     newcanvas $window.b.fs.freeino.canvas
  317.     pack  $window.b.fs.freeino.label -side left
  318.     pack  $window.b.fs.freeino.canvas -side left
  319.  
  320.     pack $window.b.fs.fsys \
  321.     $window.b.fs.dev $window.b.fs.type \
  322.     $window.b.fs.free \
  323.     $window.b.fs.freeino -side top -anchor w -padx $setup(widthc)
  324.  
  325.     pack $window.b.v -side top -anchor w -fill x -expand 1
  326.  
  327.     pack $window.b.fs -side bottom -anchor w -fill x -expand 1
  328.  
  329.     pack $window.b.finfo -side top -anchor w \
  330.     -fill x -expand 1
  331.  
  332.     pack $window.b
  333.  
  334.     pack $window -fill both -expand 1
  335. #    pack $window.b
  336.     place $window.b -in $window -relx 0 -rely 0 -relheight 1 -relwidth 1
  337. }
  338.  
  339. proc info_bar {win percent} {
  340.     global setup
  341.     set w [winfo width $win]
  342.     set s [expr (100-$percent)*$w/100]
  343.     
  344.     $win coords bar 0 0 $s 50
  345.     puts stderr "Width: $w $s\n\r"
  346. }
  347.  
  348. proc info_none {win} {
  349.     $win coords bar 0 0 0 0
  350.     
  351. }
  352.  
  353. proc newcanvas {win} {
  354.     global setup
  355.     canvas $win -height $setup(heightc) -relief sunken -border 2
  356.     $win create rectangle 0 0 0 0 -tags bar -fill black -stipple gray50
  357. }
  358.  
  359. proc infotext {win text} {
  360.     $win configure -text $text
  361. }
  362.  
  363.     # w containes the window name *and* the .b frame (like: .left.o2.b)
  364.     # FIXME: We should also display the rdev information
  365. proc info_update {w
  366.                   fname dev ino 
  367.           mode mode_oct 
  368.           links owner group 
  369.                   have_blocks blocks 
  370.           size 
  371.           have_rdev rdev rdev2
  372.           create modify access
  373.           fsys dev type 
  374.           have_space avail percent total
  375.           have_ino   nfree inoperc inotot} {
  376.  
  377.     # 
  378.     # Set all the text information
  379.     # 
  380.     infotext $w.finfo.fname    "File:\t\t$fname"
  381.     infotext $w.finfo.location "Location:\t\t${dev}h:${ino}h"
  382.     infotext $w.finfo.mode     "Mode:\t\t$mode ($mode_oct)"
  383.     infotext $w.finfo.links    "Links:\t\t$links"
  384.     infotext $w.finfo.owner    "Owner:\t\t$owner/$group"
  385.     if $have_blocks {
  386.     infotext $w.finfo.size     "Size:\t\t$size ($blocks blocks)"
  387.     } else {
  388.     infotext $w.finfo.size     "Size:\t\t$size"
  389.     }
  390.     infotext $w.finfo.created  "Created:\t\t$create"
  391.     infotext $w.finfo.modified "Modified:\t\t$modify"
  392.     infotext $w.finfo.access   "Accessed:\t$access"
  393.    
  394.     infotext $w.fs.fsys "Filesystem:\t$fsys"
  395.     infotext $w.fs.dev  "Device:\t\t$dev"
  396.     infotext $w.fs.type "Type:\t\t$type"
  397.     if $have_space {
  398.     infotext $w.fs.free.label \
  399.        "Free Space $avail ($percent%) of $total"
  400.     info_bar $w.fs.free.canvas $percent
  401.     } else {
  402.     infotext $w.fs.free.label "No space information"
  403.     info_none $w.fs.free.canvas
  404.     }
  405.     if $have_ino {
  406.     infotext $w.fs.freeino.label \
  407.        "Free inodes $nfree ($inoperc%) of $inotot"
  408.     info_bar $w.fs.freeino.canvas $inoperc
  409.     } else {
  410.     infotext $w.fs.freeino.label "No inode information"
  411.     info_none $w.fs.freeino.canvas
  412.     }
  413. }
  414.  
  415. #
  416. #  Widget: listbox
  417. #
  418. proc listbox_sel {win item} {
  419.     $win selection clear 0 end
  420.     $win selection set $item
  421. }
  422.  
  423. #
  424. # Widget: WPanel
  425. #
  426. proc panel_select {w pos cback} {
  427.     $w.m.panel tag add se $pos.0 "$pos.0 lineend"
  428.     $w.m.panel see $pos.0
  429.     $cback top [$w.m.panel index @0,0]
  430. }
  431.  
  432. proc panel_scroll {win cback args} {
  433.     eval "$win yview $args"
  434.     $cback top [$win index @0,0]
  435. }
  436.  
  437. proc panel_setup {which} {
  438.     global setup
  439.  
  440.     frame $which
  441.  
  442.     label $which.cwd -text "wait..."
  443.     frame $which.m
  444.     label $which.mini
  445.     scrollbar $which.m.scroll -width 3m
  446.     text  $which.m.panel -width $setup(cols) -yscroll "$which.m.scroll set" \
  447.     -font $setup(panelfont) -fore $setup(def_fore) -back $setup(def_back) \
  448.     -wrap none -height $setup(lines)
  449.  
  450.     bindtags $which.m.panel "all . $which.m.panel"
  451.     
  452.     pack $which.m.panel -side left -fill both -expand 1
  453.     pack $which.m.scroll -side right -fill y
  454.  
  455.     pack $which.cwd  -side top -anchor w
  456.     pack $which.m    -side top -fill both -expand 1
  457.     pack $which.mini -side top -fill x
  458.  
  459.     pack $which -fill both -expand 1
  460.     # Tags: st (selected), sm (selected+marked), ma (marked), re (regular)
  461.     config_colors $which.m.panel
  462. }
  463.  
  464.     #
  465.     # Draging the panels:
  466.     # mc_x and mc_y contains the last positions where the mouse was
  467.     # mc_repeat     contains the id of the after command.
  468.     #
  469. proc panel_cancel_repeat {} {
  470.     global mc_repeat
  471.  
  472.     after cancel $mc_repeat
  473.     set mc_repeat {}
  474. }
  475.  
  476.     #
  477.     #  This routine passes the size of the text widget back to the C code
  478.     #
  479.  
  480. proc panel_drag {w cmd n} {
  481.     global mc_y
  482.     global mc_x
  483.     global mc_repeat
  484.  
  485.     if {$mc_y >= [winfo height $w]} {
  486.     $w yview scroll 1 units 
  487.     } elseif {$mc_y < 0} {
  488.     $w yview scroll -1 units
  489.     } else {
  490.     return
  491.     }
  492.     $cmd top [$w index @0,0]
  493.     $cmd motion $n [$w index @$mc_x,$mc_y]
  494.     set mc_repeat [after 50 panel_drag $w $cmd $n]
  495. }
  496.  
  497. proc panel_size {cmd panel w h} {
  498.     global setup
  499.  
  500.     set setup(height) $h
  501.     set setup(width)  $w
  502.     set setup(lines) [expr $h/$setup(heightc)]
  503.     set setup(cols)  [expr $w/$setup(widthc)]
  504.     $cmd resize $panel
  505. }
  506.  
  507.     #
  508.     # Called on the first idle loop to configure the sizes of the thing
  509.     #
  510. proc panel_conf {panel cmd} {
  511.     global setup
  512.  
  513.     set font [lindex [$panel configure -font] 4]
  514.     set fontinfo [$cmd fontdim $font $panel]
  515.  
  516.     set setup(heightc) [lindex $fontinfo 0]
  517.     set setup(widthc)  [lindex $fontinfo 1]
  518.  
  519.     bind $panel <Configure> "panel_size $cmd $panel %w %h"
  520. }
  521.  
  522.     #
  523.     # Mouse bindings for the panels
  524.     #
  525. proc panel_bind {the_panel panel_cmd} {
  526.     global setup
  527.  
  528.     bind $the_panel.m.panel <Button-1> "
  529.         $panel_cmd mdown 3  \[%W index @%x,%y]
  530.     "
  531.  
  532.     bind $the_panel.m.panel <ButtonRelease-1> "
  533.         panel_cancel_repeat
  534.         $panel_cmd mup 3    \[%W index @%x,%y]"
  535.  
  536.     bind $the_panel.m.panel <Double-1> "
  537.         panel_cancel_repeat
  538.         $panel_cmd double 3 \[%W index @%x,%y]"
  539.  
  540.     bind $the_panel.m.panel <B1-Motion> "
  541.        set mc_x %x
  542.        set mc_y %y
  543.        $panel_cmd motion 3 \[%W index @%x,%y]
  544.     "
  545.  
  546.     bind $the_panel.m.panel <B1-Leave> "
  547.         set mc_x %x
  548.         set mc_y %y
  549.     panel_drag %W $panel_cmd 3
  550.     "
  551.  
  552.     bind $the_panel.m.panel <B1-Enter> panel_cancel_repeat
  553.  
  554.     bind $the_panel.m.panel <Button-3> "
  555.         $panel_cmd mdown 1  \[%W index @%x,%y]"
  556.  
  557.     bind $the_panel.m.panel <ButtonRelease-3> "
  558.         $panel_cmd mup 1    \[%W index @%x,%y]
  559.         panel_cancel_repeat
  560.     "
  561.  
  562.     bind $the_panel.m.panel <B3-Motion> "
  563.         set mc_x %x
  564.         set mc_y %y
  565.         $panel_cmd motion 1 \[%W index @%x,%y]
  566.     "
  567.  
  568.     bind $the_panel.m.panel <B3-Leave> "
  569.         set mc_x %x
  570.         set mc_y %y
  571.     panel_drag %W $panel_cmd 1
  572.     "
  573.     
  574.     bind $the_panel.m.panel <B3-Enter> panel_cancel_repeat
  575.     $the_panel.m.scroll configure \
  576.         -command "panel_scroll $the_panel.m.panel $panel_cmd"
  577.  
  578.     panel_conf $the_panel.m.panel $panel_cmd
  579. }
  580.  
  581. proc panel_width {} {
  582.     global setup
  583.     return $setup(cols)
  584. }
  585.  
  586. proc panel_height {} {
  587.     global setup
  588.     return $setup(lines)
  589. }
  590.  
  591. proc panel_mark {tag panel n} {
  592.     config_colors $panel
  593.     puts stderr "TAG: $tag, LINEA=$n\n\r"
  594.     $panel tag add $tag "${n}.0" "${n}.0 lineend"
  595. }
  596.  
  597. #
  598. # Misc routines
  599. #
  600. proc config_colors {which} {
  601.     global setup
  602.  
  603.     $which tag configure se -back $setup(selected) -fore $setup(selected_fg)
  604.     $which tag configure ma -fore $setup(marked)
  605. }
  606.  
  607. proc tclerror {msg} {
  608.  puts stderr "TkError: [$msg]\n\r"
  609. }
  610.  
  611. #
  612. # FIXME: This is not finished, have to deal with activefore, activeback
  613. # highlight{fore,back}
  614. #
  615. proc error_colors {wins} {
  616.     global setup
  617.  
  618.     foreach widget $wins {
  619.     catch "$widget configure -foreground $setup(errorfore)"
  620.     catch "$widget configure -background $setup(errorback)"
  621.     }
  622. }
  623.  
  624. #
  625. #
  626. # Layout routines
  627. #
  628. #
  629. proc layout_midnight {} {
  630.     global one_window
  631.     global wlist
  632.  
  633.     puts $wlist
  634.     #
  635.     # we want to make the prompt and the input line sunken
  636.     # so we sunk the frame, and set a borderwidth for it
  637.     # while removing the sunken attribute set by the newinput
  638.     .p.i0 configure -relief flat
  639.     .p configure -relief sunken -borderwidth 2
  640.     pack .p.l5 -side left 
  641.     pack .p.i0 -side left -expand 1 -fill x -anchor e
  642.     pack .n4 -side bottom -fill x
  643.     pack .p -side bottom -fill x
  644.     if $one_window {
  645.     pack .left -side top -side left -fill both -expand 1
  646.     pack .right -side top -side right -fill both -expand 1
  647.     }
  648. }
  649.  
  650. proc layout_query_xxx {} {
  651.     global wlist
  652.  
  653.     set t [llength $wlist]
  654.     if {$t == 2} {
  655.     pack .query.l0 -side top -pady 2m -padx 2m
  656.     pack .query.b1 -side right  -ipadx 2m -padx 4m -pady 2m -expand 1
  657.     } else {
  658.     pack .query.l1  -side top -pady 2m -padx 2m
  659.  
  660.     for {set b 2} {$b != 1} {incr b} {
  661.         if {$b == $t} {
  662.         set b 0
  663.         }
  664.         pack .query.b$b -side right -ipadx 2m -padx 4m -pady 2m -expand 1
  665.     }
  666.     }
  667. }
  668.  
  669. proc layout_display {} {
  670.     pack .display.r.r1 -side left
  671.     pack .display.r.i2 -side right -fill x -expand 1 -anchor s
  672.  
  673.     pack .display.m.c3 -side top -anchor w
  674.     pack .display.m.i4 -side top -fill x -expand 1
  675.  
  676.     pack .display.b.b5 -side left -padx 2m
  677.     pack .display.b.b0 -side left -padx 2m
  678.  
  679.     pack .display.r -side top -fill x -expand 1 -padx 3m -pady 8m
  680.     pack .display.m -side top -fill x -expand 1 -padx 3m
  681.     pack .display.b -side top -expand 1 -padx 3m -pady 8m
  682. }
  683.  
  684. proc layout_sort_xxx {} {
  685.     pack .sort.r.r1 -side left -padx 4m
  686.     pack .sort.r.c2 -side right -padx 4m -pady 4m -anchor n
  687.     pack .sort.b.b3 -side left -padx 4m
  688.     pack .sort.b.b0 -side left -padx 4m
  689.  
  690.     pack .sort.r -side top -pady 8m
  691.     pack .sort.b -pady 4m -side top
  692. }
  693.  
  694. proc layout_findfile {} {
  695.     label .findfile.l
  696.     pack .findfile.l -side top
  697.     pack .findfile.l1 -side top -anchor w -padx 4m
  698.     pack .findfile.i0 -side top -fill x -expand 1 -anchor w -padx 4m
  699.     pack .findfile.l2 -side top -anchor w -padx 4m
  700.     pack .findfile.i3 -side top -fill x -expand 1 -anchor w -padx 4m
  701.     pack .findfile.b.b4 .findfile.b.b5 .findfile.b.b6 -side left \
  702.     -expand 1 -padx 4m
  703.     pack .findfile.b -pady 4m -padx 4m
  704. }
  705.  
  706. proc layout_option {} {
  707.     global wlist
  708.     puts stderr "$wlist\n\r" 
  709.     # group name: buttons
  710.     pack .option.b.b22 .option.b.b23 .option.b.b0 -side left -padx 4m -pady 4m
  711.     pack .option.b -side bottom  
  712.     
  713.     # group name: panel options
  714.     pack .option.c.l1 -side top -anchor w
  715.     pack .option.c.c11 .option.c.c12 .option.c.c13 .option.c.c14 \
  716.     .option.c.c15 .option.c.c16 .option.c.c17 .option.c.c18  \
  717.     .option.c.c19 .option.c.c20 .option.c.c21 -side top -anchor w
  718.     .option.c configure -relief sunken 
  719.     pack .option.c -padx 4m -pady 4m -side right -anchor n -fill y 
  720.  
  721.     # group name: other options
  722.     pack .option.o.l10 -side top -anchor w
  723.     pack .option.o.c2 .option.o.c3 .option.o.c4 .option.o.c5 \
  724.     .option.o.c6 .option.o.c7 -side top -anchor w
  725.     .option.o configure -relief sunken 
  726.     pack .option.o -side top -padx 4m -pady 4m -side top
  727.  
  728.     # group name: pause after run...
  729.     pack .option.p.l8 -side top -anchor w
  730.     pack .option.p.r9 -side top -anchor w
  731.     .option.p configure -relief sunken
  732.     pack .option.p -padx 4m -pady 4m -side top
  733.  
  734. }
  735.  
  736. proc layout_listbox {} {
  737.     scrollbar .listbox.s -width 3m -command {.listbox.x0 yview}
  738.     .listbox.x0 configure -yscroll {.listbox.s set} 
  739.     pack .listbox.s -fill y -side right
  740.     pack .listbox.x0 -expand 1 -fill both -padx 4m -pady 4m -side left
  741. }
  742.  
  743. proc layout_mfind {} {
  744.     scrollbar .mfind.s -width 3m -command {.mfind.x1 yview}
  745.     .mfind.x1 configure  -yscroll {.mfind.s set} 
  746.  
  747.     pack .mfind.b.b0 .mfind.b.b3 .mfind.b.b4 .mfind.b.b5 .mfind.b.b6 \
  748.     -side left -padx 4m -expand 1 -fill x -pady 2m
  749.  
  750.     pack .mfind.b -fill x -expand 1 -side bottom
  751.     pack .mfind.l2 -anchor w -expand 1 -anchor w -padx 4m -side bottom
  752.     pack .mfind.x1 -side left -fill both -expand 1 -pady 2m
  753.     pack .mfind.s -side right -fill y -expand 1
  754. }
  755.  
  756. proc layout_quick_confirm {} {
  757.     pack .quick_confirm.c.c1 .quick_confirm.c.c2 .quick_confirm.c.c3 \
  758.     -side top -anchor w
  759.     pack .quick_confirm.b.b0 .quick_confirm.b.b4 -side left -padx 4m -expand 1
  760.     
  761.     pack .quick_confirm.c -side top -pady 4m
  762.     pack .quick_confirm.b -side top -pady 2m
  763. }
  764.  
  765. proc layout_quick_file_mask {} {
  766.     global wlist
  767.     puts stderr "$wlist"
  768.  
  769.     # We add some space
  770.     .quick_file_mask configure -borderwidth 5m
  771.  
  772.     pack .quick_file_mask.b.b1 .quick_file_mask.b.b2 \
  773.     -side left -expand 1 -padx 4m
  774.  
  775.     pack .quick_file_mask.l3  -side top -anchor w -expand 1
  776.     pack .quick_file_mask.s.i5 -fill x -expand 1 -anchor w
  777.     pack .quick_file_mask.s.c6 -anchor e -padx 4m -pady 1m
  778.     pack .quick_file_mask.s -expand 1 -fill x -side top
  779.  
  780.     pack .quick_file_mask.d.l7 -pady 4m
  781.     pack .quick_file_mask.d -side top -anchor w
  782.     pack .quick_file_mask.i4 -expand 1 -fill x -side top
  783.  
  784.     pack .quick_file_mask.t.c8 .quick_file_mask.t.c0 -side top -anchor e
  785.     catch {pack .quick_file_mask.t.c9 -side top -anchor e}
  786.  
  787.     pack .quick_file_mask.t -side top -anchor e
  788.     frame .quick_file_mask.space -height 4m
  789.     pack .quick_file_mask.space -side top 
  790.     pack .quick_file_mask.b -fill x -expand 1 -side top
  791. }
  792.  
  793. proc layout_quick_vfs {} {
  794.     global wlist
  795.     puts stderr "$wlist"
  796.     pack .quick_vfs.t.l1 -side left
  797.     pack .quick_vfs.t.i2 -side left -expand 1 -fill x -padx 2m
  798.     pack .quick_vfs.t.l3 -side left
  799.  
  800.     pack .quick_vfs.l.l4 -side top -anchor w
  801.     pack .quick_vfs.l.r5 -side left -anchor w
  802.     pack .quick_vfs.l.i6 -side right -anchor se
  803.     pack .quick_vfs.b.b7 .quick_vfs.b.b0 -padx 4m -side left -expand 1 
  804.  
  805.     pack .quick_vfs.t -side top -expand 1 -fill x -pady 4m -padx 4m
  806.     pack .quick_vfs.l -side top -expand 1 -fill x -padx 4m
  807.     pack .quick_vfs.b -side top -expand 1 -fill x -padx 4m -pady 4m
  808. }
  809.  
  810. proc layout_dbits {} { 
  811.     pack .dbits.r1 -anchor w -padx 4m -pady 4m -side top
  812.     pack .dbits.b0 -side top
  813. }
  814.  
  815. proc layout_chown {} {
  816.     global setup
  817.  
  818.     pack .chown.b.b8 .chown.b.b0 -side left -padx 4m -expand 1
  819.  
  820.     # May be invoked with different number of buttons
  821.     # There is already a problem: the cancel button is
  822.     # not close to the ok button, I will have to look into this.
  823.     catch { 
  824.     pack .chown.b.b9 .chown.b.b10 .chown.b.b11 \
  825.         -side left -padx 4m -expand 1
  826.     }
  827.     label .chown.l.fname -text {File name}
  828.     label .chown.l.owner -text {Owner name}
  829.     label .chown.l.group -text {Group name}
  830.     label .chown.l.size -text {Size}
  831.     label .chown.l.perm -text {Permission}
  832.     
  833.     pack \
  834.     .chown.l.fname .chown.l.l7 \
  835.     .chown.l.owner .chown.l.l6 \
  836.     .chown.l.group .chown.l.l5 \
  837.     .chown.l.size  .chown.l.l4 \
  838.     .chown.l.perm  .chown.l.l3 -side top -anchor w -padx 2m
  839.     
  840.     foreach i {l3 l4 l5 l6 l7} {
  841.     .chown.l.$i configure -fore $setup(high)
  842.     }
  843.     pack .chown.l.l3 .chown.l.l4 .chown.l.l5 .chown.l.l6 .chown.l.l7 \
  844.     -side top -pady 1m -padx 4m -anchor w
  845.  
  846.     # Configure the listboxes
  847.     scrollbar .chown.f.s -width 3m -command {.chown.f.x2 yview}
  848.     .chown.f.x2 configure -yscroll {.chown.f.s set}
  849.     label .chown.f.l -text {Group name}
  850.     pack .chown.f.l -side top -anchor w
  851.     pack .chown.f.x2 -side left -fill y -expand 1
  852.     pack .chown.f.s -side right -fill y -expand 1
  853.  
  854.     scrollbar .chown.g.s -width 3m -command {.chown.g.x1 yview}
  855.     .chown.g.x1 configure -yscroll {.chown.g.s set}
  856.     label .chown.g.l -text {User name}
  857.     pack .chown.g.l -side top -anchor w
  858.     pack .chown.g.x1 -side left -fill y -expand 1
  859.     pack .chown.g.s -side right -fill y -expand 1
  860.  
  861.     .chown.b configure -relief sunken
  862.     pack .chown.b -side bottom -pady 4m -fill x
  863.     pack .chown.g .chown.f -side left -padx 4m -pady 4m -expand 1 -fill y
  864.     pack .chown.l -side right -padx 4m
  865. }
  866.  
  867. proc layout_chmod {} {
  868.     global wlist
  869.     puts stderr "$wlist \n\r"
  870.     pack .chmod.c.c5 .chmod.c.c6 .chmod.c.c7 .chmod.c.c8 .chmod.c.c9 \
  871.     .chmod.c.c10 \
  872.     .chmod.c.c11 .chmod.c.c12 .chmod.c.c13 .chmod.c.c14 .chmod.c.c15 \
  873.     .chmod.c.c16 -side top -anchor w
  874.  
  875.     pack .chmod.b.b17 .chmod.b.b0 -side left -padx 4m -pady 4m -side left
  876.     catch {
  877.     pack .chmod.b.b18 .chmod.b.b19 .chmod.b.b19 .chmod.b.b20 \
  878.         .chmod.b.b21 -side left -padx 4m -pady 4m -side left
  879.     }
  880.  
  881.     label .chmod.l.msg -text {Use "t" or Insert to\nmark attributes}
  882.     label .chmod.l.fname -text {Name}
  883.     label .chmod.l.perm   -text {Permission (octal)}
  884.     label .chmod.l.owner  -text {Owner name}
  885.     label .chmod.l.group  -text {Group name}
  886.  
  887.     pack \
  888.     .chmod.l.fname .chmod.l.l4 \
  889.     .chmod.l.perm  .chmod.l.l1 \
  890.     .chmod.l.owner .chmod.l.l3 \
  891.     .chmod.l.group .chmod.l.l2 .chmod.l.msg -side top -anchor w -padx 2m
  892.     pack .chmod.b -side bottom
  893.     pack .chmod.l -side right -padx 4m -anchor n -pady 4m
  894.     pack .chmod.c -side left -padx 4m -pady 4m
  895. }
  896.  
  897. proc layout_view {} {
  898.     global wlist
  899.  
  900.     pack [lindex $wlist 0] -side bottom -fill x
  901.     pack [lindex $wlist 1] -side top -expand 1 -fill both
  902. }
  903.  
  904. proc layout_replace {} {
  905.     global wlist
  906.  
  907.     error_colors "$wlist .replace"
  908.  
  909.     set alist {}
  910.     set plist {}
  911.     set ilist {}
  912.  
  913.     foreach a $wlist {
  914.     if [regexp ^.replace.p.l $a] {
  915.         set plabel $a
  916.     } elseif [regexp ^.replace.p $a] {
  917.         set plist "$plist $a"
  918.     } elseif [regexp ^.replace.a.l $a] {
  919.         set alabel $a
  920.     } elseif [regexp ^.replace.a $a] {
  921.         set alist "$alist $a"
  922.     } elseif [regexp ^.replace.i $a] {
  923.         set ilist "$ilist $a"
  924.     } elseif [regexp ^.replace.b $a] {
  925.         set abortbutton $a
  926.     } else {
  927.         set fname $a
  928.     }
  929.     }
  930.  
  931.     puts stderr "$wlist\n\r"
  932.     puts stderr "alist: $alist\n\rplist: $plist\n\rilist: $ilist\n\r"
  933.     puts stderr "plabel: $plabel\n\rfname: $fname"
  934.  
  935.     pack $fname -side top -fill x -anchor w -pady 6m -padx 12m
  936.     pack $abortbutton -side bottom -anchor e -padx 8m -pady 4m
  937.     
  938.     eval pack $ilist -side top -anchor w 
  939.     pack .replace.i -padx 10m -pady 2m -anchor w
  940.  
  941.     pack $plabel -side left -anchor w -padx 10m
  942.     eval pack $plist -side left -anchor e -fill x
  943.     pack .replace.p -side top -fill x -padx 10m
  944.     
  945.     pack $alabel -side left -anchor w -padx 10m
  946.     eval pack $alist -side left -anchor e -fill x
  947.     pack .replace.a -side top -fill x  -padx 10m
  948. }
  949.  
  950. proc layout_complete {} {
  951.     global wlist
  952.  
  953.     eval pack $wlist -side top
  954. }
  955.  
  956. proc layout_opwin {} {
  957.     global wlist
  958.     global setup
  959.  
  960.     pack .opwin.b.b0 .opwin.b.b11 -side left -expand 1
  961.     pack .opwin.f0.l1 .opwin.f0.l2 -side left -anchor w
  962.     pack .opwin.f1.l3 .opwin.f1.l4 -side left -anchor w
  963.  
  964.     foreach a {.opwin.2.l9 .opwin.1.l7 .opwin.0.l5} {
  965.     $a configure -width 8
  966.     }
  967.     pack .opwin.2.l9 .opwin.2.g10 -side left -fill x
  968.     pack .opwin.1.l7 .opwin.1.g8  -side left -fill x
  969.     pack .opwin.0.l5 .opwin.0.g6  -side left -fill x
  970.  
  971.     pack .opwin.b -side bottom -pady 4m -fill x
  972.     pack .opwin.f0 -side top -padx 10m -anchor w
  973.     pack .opwin.f1 -side top -padx 10m -pady 4m -anchor w
  974.     pack .opwin.0 .opwin.1 .opwin.2 -side top -padx 4m
  975. }
  976.  
  977. proc dummy_layout {name} {
  978.     eval "proc layout_$name {} {
  979.           global wlist
  980.           puts stderr \"\$wlist \\n\"
  981.           eval pack \$wlist -side top}"
  982. }
  983. #
  984. # the achown commands will have to be rewriten
  985. # to use only widgets and no writing callbacks.
  986. #
  987.  
  988. foreach i {
  989.     achown tree 
  990.     } {
  991.     dummy_layout $i
  992.     }
  993.  
  994. proc layout_quick_input {} {
  995.     global wlist
  996.  
  997.     puts stderr "$wlist \n\r"
  998.     .quick_input.i1 configure -width 60
  999.     label .quick_input.dummy
  1000.     pack .quick_input.b.b2 .quick_input.b.b3 -side left -padx 4m -expand 1
  1001.     pack .quick_input.b -side bottom -pady 4m
  1002.     pack .quick_input.dummy -side top
  1003.     pack .quick_input.l0 -side top -expand 1 -ipadx 2m -ipady 2m
  1004.     pack .quick_input.i1 -side bottom -fill x -padx 4m
  1005. }
  1006.  
  1007. #
  1008. # Removes all of the widgets in a container (.left or .right)
  1009. #
  1010. proc container_clean {container} {
  1011.     set widgets [winfo children $container]
  1012.  
  1013.     foreach widget $widgets {
  1014.     destroy $widget
  1015.     }
  1016. }
  1017.  
  1018. #
  1019. # Setups the binding called after the layout procedure
  1020. #
  1021. proc bind_setup {win} {
  1022.     flush stderr
  1023.     bindtags $win {all $win}
  1024.     bind $win <Leave> 
  1025.     bind $win <Key>              "tkmc r %A"
  1026.     bind $win <Alt-KeyPress>     "tkmc a %A"
  1027.     bind $win <Meta-KeyPress>    "tkmc a %A"
  1028.     bind $win <Control-KeyPress> "tkmc c %A"
  1029.     foreach i {Left Right Up Down End R13 Home F27 F29 Prior \
  1030.            Next F35 Return KP_Enter Delete Insert BackSpace \
  1031.            F1 F2 F3 F4 F5 F6 F7 F8 F9 F10} {
  1032.         bind $win <Key-$i> "tkmc k %K"
  1033.     }
  1034. }
  1035.  
  1036. # Centers a window based on .
  1037. proc center_win {win} {
  1038.     global center_toplevels
  1039.  
  1040.     wm transient $win [winfo toplevel [winfo parent $win]]
  1041.  
  1042.     wm withdraw $win
  1043.     update idletasks
  1044.  
  1045.     if {$center_toplevels} {
  1046.     set cw [winfo reqheight $win]
  1047.     set ch [winfo reqwidth $win]
  1048.     
  1049.     set geo [split [wm geometry .] +x]
  1050.     set pw [lindex $geo 0]
  1051.     set ph [lindex $geo 1]
  1052.     set px [lindex $geo 2]
  1053.     set py [lindex $geo 3]
  1054.     
  1055.     set x [expr $px+(($pw-$cw)/2)]
  1056.     set y [expr $py+(($ph-$ch)/2)]
  1057.     
  1058.     wm geometry $win +$x+$y
  1059.     }
  1060.     wm deiconify $win
  1061.     grab $win
  1062.     tkwait visibility $win
  1063. }
  1064.  
  1065. #
  1066. # Busy window handling
  1067. #
  1068. proc win_busy {w} {
  1069.     $w configure -cursor watch
  1070. }
  1071.  
  1072.  
  1073. #
  1074. # Color configurations
  1075. #
  1076. proc tk_colors {} {
  1077. }
  1078.  
  1079. proc color_model {} {
  1080. }
  1081.  
  1082. # gray85 is the background for the new tk4
  1083. proc gray_colors {base} {
  1084.     global setup
  1085.  
  1086.     set dark_color [tkDarken $base 90]
  1087. #    set setup(def_back) [tkDarken $base 90]
  1088. #    set setup(def_fore) black
  1089. #    set setup(selected) [tkDarken $base 110]
  1090. #    set setup(marked)   SlateBlue
  1091. #    set setup(high)     $setup(def_back)
  1092.  
  1093.     set setup(def_back) [tkDarken $base 110]
  1094.     set setup(def_fore) black
  1095.     set setup(selected) NavyBlue
  1096.     set setup(selected_fg) white
  1097.     set setup(marked)   yellow
  1098.     set setup(high)     yellow
  1099.    
  1100. # Viewer colors
  1101.  
  1102.     set setup(view_bold)      "-fore yellow -back $dark_color"
  1103.     set setup(view_underline) "-fore red    -back $dark_color"
  1104.     set setup(view_mark)      "-fore cyan   -back $dark_color"
  1105.     set setup(view_normal)    "-fore black  -back $dark_color"
  1106.  
  1107. # The percentage bars on info:
  1108.     set setup(percolor) "blue"
  1109.  
  1110. # The errors
  1111.     set setup(errorfore) white
  1112.     set setup(errorback) red
  1113. }
  1114.  
  1115. proc bisque_colors {} {
  1116.     global setup
  1117.  
  1118.     set setup(def_back) bisque3
  1119.     set setup(def_fore) black
  1120.     set setup(selected) bisque2
  1121.     set setup(marked)   SlateBlue
  1122.     set setup(high)     gray
  1123. }
  1124.  
  1125. proc sanity_check {} {
  1126.     if [catch {bindtags .}] {
  1127.     puts stderr "The Midnight Commander requires Tk 4.0 beta 3 or 4\n\r"
  1128.     puts stderr "You can get it from: ftp://ftp.smli.com/pub/tcl"
  1129.     exit 1
  1130.     }
  1131. }
  1132.  
  1133. #sanity_check
  1134.  
  1135. # Until I figure out how to remove specific bindings from a widget
  1136. # I remove all of the classes bindings.
  1137.  
  1138. #bind Text <Enter> {}
  1139. #bind Text <FocusIn> {}
  1140.  
  1141. # bind Entry <Enter> {}
  1142. # bind Entry <FocusIn> {}
  1143.  
  1144. # Remove the Tab binding.
  1145. bind all <Tab> {}
  1146.  
  1147. set setup(lines) 24
  1148. set setup(cols)  40
  1149.  
  1150. #
  1151. # Debugging routines
  1152. toplevel .command
  1153. entry .command.i
  1154. pack .command.i -side left
  1155. button .command.ok -command {eval [.command.i get]} -text "Eval"
  1156. pack .command.ok
  1157. button .command.quit -command {exit} -text "Aieee!"
  1158. pack .command.quit
  1159. bind .command.quit <Key-Return> {.command.ok invoke}
  1160.  
  1161. # Determine Tk version
  1162. set beta_4 ![catch tk_bisque]
  1163. if $beta_4 { 
  1164.     tk_setPalette gray85
  1165.     gray_colors gray70
  1166. } else {
  1167.     bisque_colors 
  1168. }
  1169.  
  1170. ## Some globals
  1171. set mc_repeat {}
  1172. set mc_x 0
  1173. set mc_y 0
  1174. set center_toplevels 1
  1175.  
  1176. set setup(panelfont) lucidasanstypewriter-bold-14
  1177. set setup(font) "-*-helvetica-medium-r-normal-*-14-*-*-*-*-*-*-*"
  1178.  
  1179. if [file exist ~/.tkmc] {source ~/.tkmc}
  1180. catch {
  1181.     option add *font $setup(font) userDefault
  1182.     option add *Menu*activeBackground NavyBlue
  1183.     option add *Menu*activeForeground white
  1184.     option add *Menubutton*activeBackground NavyBlue
  1185.     option add *Menubutton*activeForeground white
  1186.     option add *Button*activeBackground NavyBlue
  1187.     option add *Button*activeForeground white
  1188. #    set setup(panelfont) $setup(font)
  1189. }
  1190.  
  1191. create_top_menu
  1192.